home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume2 / basic / part3 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  59.7 KB
  1. From: ukma!david (David Herron, NPR Lover)
  2. Subject: A BASIC interpretor (Part 3 of 4)
  3. Newsgroups: mod.sources
  4. Approved: john@genrad.UUCP
  5.  
  6. Mod.sources:  Volume 2, Issue 25
  7. Submitted by: ukma!david (David Herron)
  8.  
  9.  
  10. #! /bin/sh
  11. # This is a shell archive, meaning:
  12. # 1. Remove everything above the #! /bin/sh line.
  13. # 2. Save the resulting text in a file.
  14. # 3. Execute the file with /bin/sh (not csh) to create the files:
  15. #    bs2/action.c
  16. #    bs2/bsdefs.h
  17. #    bs2/bsgram.y
  18. #    bs2/bsgram.y.orig
  19. #    bs2/bsint.c
  20. #    bs2/bslib.c
  21. #    bs2/errors.c
  22. #    bs2/operat.c
  23. # This archive created: Tue Jul 30 13:03:04 1985
  24. export PATH; PATH=/bin:$PATH
  25. if test ! -d 'bs2'
  26. then
  27.     echo shar: creating directory "'bs2'"
  28.     mkdir 'bs2'
  29. fi
  30. echo shar: extracting "'bs2/action.c'" '(14073 characters)'
  31. if test -f 'bs2/action.c'
  32. then
  33.     echo shar: will not over-write existing file "'bs2/action.c'"
  34. else
  35. sed 's/^X//' << \SHAR_EOF > 'bs2/action.c'
  36. /* action.c -- "action" routines for interpretor.  These are the base-level
  37.  *    routines, pointed to by the code-list.
  38.  */
  39.  
  40. #include "bsdefs.h"
  41.  
  42. int status = 0;
  43.  
  44. /* M_COMPILE:
  45.  *    x print x   --to--   x,_print,x
  46.  * M_EXECUTE:
  47.  *    stack: string,x   --to--   x
  48.  *    output: "string\n"
  49.  */
  50. _print(l,p)
  51. int (*l[])(),p;
  52. {
  53.     union value s1;
  54.     switch(status&XMODE) {
  55.     case M_EXECUTE:
  56.         s1 = pop();
  57.         printf("%s",s1.sval);
  58.         if(s1.sval != 0) free(s1.sval);
  59.     case M_FIXUP:
  60.     case M_COMPILE: return(p);
  61.     default:
  62.         STerror("print");
  63.     }
  64. }
  65.  
  66. /* M_COMPILE:
  67.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  68.  *    (the 0 is for the benefit of interp())
  69.  * M_FIXUP: nothing.
  70.  * any other mode:
  71.  *    stack: lval,x    --to--    x
  72.  *    other: Thisline = lval.lval.codelist;
  73.  *           Thisp = lval.lval.place;
  74.  */
  75. _goto(l,p) int (*l[])(),p;
  76. {
  77.     union value lval;
  78.  
  79.     switch(status&XMODE) {
  80.     case M_COMPILE: l[p] = 0;
  81.     case M_FIXUP: return(++p);
  82.     default:
  83.         lval = pop();
  84.         if(lval.lval.codelist == 0) ULerror(l,p);
  85.         Thisline = lval.lval.codelist;
  86.         Thisline--;
  87.         Thisp = lval.lval.place;
  88. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  89.     lval.lval.place,lval.lval.codelist->num);
  90.         return(p);
  91.     }
  92. }
  93.  
  94. /* M_COMPILE:
  95.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  96.  * M_FIXUP:
  97.  *    Make vlist entry for "name" point to current place.
  98.  */
  99. _dlabel(l,p) int (*l[])(),p;
  100. {
  101.     struct dictnode *vp;
  102.     char *s;
  103.  
  104.     switch(status&XMODE) {
  105.     case M_COMPILE:
  106.         s=gtok();
  107.         vp=gvadr(s,T_LBL);
  108.         l[p++] = vp;
  109.         return(p);
  110.     case M_FIXUP:
  111.         vp=l[p++];
  112.         vp->val.lval.codelist = (int **)gllentry(l);
  113.         vp->val.lval.place = p;
  114.         return(p);
  115.     default: return(++p);
  116.     }
  117. }
  118.  
  119. /* M_COMPILE:
  120.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  121.  * any other mode:
  122.  *    push(vp->val)    (i.e.  pointer to location of label)
  123.  */
  124. _rlabel(l,p) int (*l[])(),p;
  125. {
  126.     struct dictnode *vp;
  127.     char *s;
  128.  
  129.     switch(status&XMODE) {
  130.     case M_COMPILE:
  131.         s=gtok();
  132.         vp=gvadr(s,T_LBL);
  133.         l[p++] = vp;
  134.         return(p);
  135.     case M_FIXUP: return(++p);
  136.     default:
  137.         vp = l[p++];
  138. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  139.     vp->val.lval.codelist,vp->val.lval.place);
  140.         push(vp->val);
  141.         return(p);
  142.     }
  143. }
  144.  
  145. /* M_COMPILE:
  146.  *    x rlabel name goto x    --to--    x,_rlabel,lval,_gosub,0,x
  147.  *
  148.  * M_EXECUTE:
  149.  *    stack: lval,x   --to--   x
  150.  *    other: saves current place (on stack) and jumps to lval.
  151.  */
  152. _gosub(l,p) int(*l[])(),p;
  153. {
  154.     union value here,there;
  155.     switch(status&XMODE) {
  156.     case M_COMPILE:
  157.     case M_FIXUP:
  158.         l[p++] = 0;
  159.         return(p);
  160.     case M_EXECUTE:
  161.         there = pop();
  162.         here.lval.codelist = gllentry(l);
  163.         here.lval.place = p+1;
  164. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  165.     here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  166.         push(here);
  167.         Thisline = there.lval.codelist;
  168.         Thisline--;
  169.         Thisp = there.lval.place;
  170.         return(p);
  171.     default: STerror("gosub");
  172.     }
  173. }
  174.  
  175. _return(l,p) int(*l[])(),p;
  176. {
  177.     union value loc;
  178.     switch(status&XMODE) {
  179.     case M_COMPILE:
  180.     case M_FIXUP:
  181.         l[p++] = 0;
  182.         return(p);
  183.     case M_EXECUTE:
  184.         loc = pop();
  185.         Thisp = loc.lval.place;
  186.         Thisline = loc.lval.codelist;
  187.         Thisline--;
  188.         return(p);
  189.     default:
  190.         STerror("return");
  191.     }
  192. }
  193.  
  194. /* Routines control entering and leaving of loops.
  195.  *
  196.  *    enter -- makes a mark that we have entered a loop, and also records
  197.  *         branch points for "continue" and "leave".
  198.  *    exitlp -- undoes the mark made by enter.
  199.  *    contin -- branches to "continue" point.
  200.  *    leave -- branches to "leave" point.
  201.  *
  202.  * The following stack structure is used to record these loop markers.
  203.  */
  204.  
  205. struct loopstack {
  206.     struct label contlb,leavlb;
  207. };
  208.  
  209. struct loopstack lpstk[20];
  210. int lpstkp = -1;    /* -1 when stack is empty.
  211.              * always points to CURRENT loop marker.
  212.              */
  213.  
  214. /* M_COMPILE:
  215.  *    x rlabel contlb rlabel leavlb enter x
  216.  *--to--
  217.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  218.  *
  219.  * M_EXECUTE:
  220.  *    loopstack: x    --to--   <contlb,leavlb>,x
  221.  */
  222. _enter(l,p) int (*l[])(),p;
  223. {
  224.     union value loc;
  225.  
  226.     if((status&XMODE) == M_EXECUTE) {
  227.     lpstkp++;
  228.     loc = pop();
  229. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  230.     loc.lval.codelist,loc.lval.place);
  231.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  232.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  233.     loc = pop();
  234. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  235.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  236.     lpstk[lpstkp].contlb.place = loc.lval.place;
  237.     }
  238.     return(p);
  239. }
  240.  
  241. /* M_EXECUTE:
  242.  *    loopstack: <contlb,leavlb>,x    --to--   x
  243.  *    other: ensures that lpstkp doesnt get less that -1;
  244.  */
  245. _exitlp(l,p) int (*l[])(),p;
  246. {
  247.     if((status&XMODE) == M_EXECUTE)
  248.     if(lpstkp >= 0)
  249.         lpstkp--;
  250.     else
  251.         lpstkp = -1;
  252. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  253.     return(p);
  254. }
  255.  
  256. /* M_COMPILE:
  257.  *    x leave x   --to--   x,_leave,0,x
  258.  *    (the 0 is for the benefit of interp())
  259.  *
  260.  * M_EXECUTE:
  261.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  262.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  263.  */
  264. _leave(l,p) int(*l[])(),p;
  265. {
  266.     switch(status&XMODE) {
  267.     case M_COMPILE:
  268.     case M_FIXUP: l[p++] = 0; return(p);
  269.     case M_EXECUTE:
  270.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  271.         LVerror(l,p);
  272.         Thisline = lpstk[lpstkp].leavlb.codelist;
  273.         Thisline--;
  274.         Thisp = lpstk[lpstkp].leavlb.place;
  275.         return(p);
  276.     default: STerror("leave");
  277.     }
  278. }
  279.  
  280. /* M_COMPILE:
  281.  *    x contin x    --to--    x,_contin,0,x
  282.  *
  283.  * M_EXECUTE:
  284.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  285.  *    other: jumps to contlb.
  286.  */
  287. _contin(l,p) int (*l[])(),p;
  288. {
  289.     switch(status&XMODE) {
  290.     case M_COMPILE:
  291.     case M_FIXUP: l[p++] = 0; return(p);
  292.     case M_EXECUTE:
  293.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  294.         CNerror(l,p);
  295.         Thisline = lpstk[lpstkp].contlb.codelist;
  296.         Thisline--;
  297.         Thisp = lpstk[lpstkp].contlb.place;
  298.         return(p);
  299.     default: STerror("contin");
  300.     }
  301. }
  302.  
  303.  
  304.  
  305. /* M_COMPILE:
  306.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  307.  *    (the 0 is for the benefit for interp()).
  308.  * M_EXECUTE:
  309.  *    stack: loc,bool,x     --to--   x
  310.  *    p: if bool, p=p else p=loc->place
  311.  */
  312. _if(l,p)
  313. int (*l[])(),p;
  314. {
  315.     union value bv,lv;
  316.  
  317.     switch(status&XMODE) {
  318.     case M_EXECUTE:
  319.         lv = pop();
  320.         bv = pop();
  321. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  322.     p,bv.ival);
  323.         if(bv.ival == (long)0) { /* jump to else part. */
  324.         Thisline = lv.lval.codelist;
  325.         Thisline--;
  326.         Thisp = lv.lval.place;
  327.         }
  328.         else p++;    /* skip the 0 so we get to the then part */
  329.         return(p);
  330.     case M_FIXUP:
  331.     case M_COMPILE: l[p++] = 0; return(p);
  332.     default: STerror("if");
  333.     }
  334. }
  335.  
  336. /* M_COMPILE:
  337.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  338.  *--to--
  339.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  340.  *
  341.  * M_EXECUTE:
  342.  *    stack: xitpt,vizd,step,to,from,vp,x
  343.  *    other: if exit conditions are correct, jump to exit point.
  344.  *        vizd is used to hold the data type for vp.  Data types
  345.  *        are always non-zero so the test for the first visit to
  346.  *        the loop is to see if vizd is 0.
  347.  */
  348. _for(l,p) int(*l[])(),p;
  349. {
  350.     union value xitpt,vizd,from,to,step,place;
  351.  
  352.     switch(status&XMODE) {
  353.     case M_COMPILE:
  354.     case M_FIXUP: l[p++] = 0; return(p);
  355.     case M_EXECUTE:
  356.         xitpt = pop();    vizd = pop();
  357.         step = pop();    to = pop();
  358.         from = pop();
  359. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  360.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  361.         if(vizd.ival == 0) { /* first visit to loop */
  362.         place = pop();
  363. if(dbg) printf("first time:var:%s:",place.vpval->name);
  364.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  365.         place.plval = getplace(place.vpval);
  366.         *(place.plval) = from;    /* since first time, set starting val */
  367. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  368.         if(vizd.ival==T_INT && step.ival==0)
  369.             if(to.ival < from.ival)
  370.                 step.ival = -1;
  371.             else
  372.                 step.ival = 1;
  373.         else if(vizd.ival==T_DBL && step.rval==0)
  374.             if(to.rval < from.rval)
  375.                 step.rval = -1;
  376.             else
  377.                 step.rval = 1;
  378.         }
  379.         else place = pop();
  380. if(dbg) printf("var.place:%o:",place.plval);
  381.  
  382.         /* The stack frame is now correctly popped off.
  383.          * Next, we check if the loop is finished.
  384.          */
  385.  
  386.         if(vizd.ival == T_INT)
  387.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  388.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  389.         else /* vizd.ival == T_DBL */
  390.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  391.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  392.  
  393.         /* Loop is not done yet, push back stack frame. */
  394.  
  395. if(dbg) printf("loop not done, push everything back\n");
  396.         push(place);    push(from);    push(to);
  397.         push(step);        push(vizd);    push(xitpt);
  398.         return(p);
  399.  
  400.     /* Come here when the loop is finished. */
  401. loop_done:
  402. if(dbg) printf("loop done, jump to xitpt\n");
  403.         Thisline = xitpt.lval.codelist;
  404.         Thisline--;
  405.         Thisp = xitpt.lval.place;
  406.         return(p);
  407.     default: STerror("for");
  408.     }
  409. }
  410.  
  411. /* M_COMPILE:
  412.  *    var name next rlabel FORx go@ dlabel FORx+1
  413.  *--to--
  414.  *    _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
  415.  *
  416.  * M_EXECUTE:
  417.  *    stack: same as M_EXECUTE in _for.
  418.  *    other: adds step to (control var)->val.
  419.  */
  420. _next(l,p) int(*l[])(),p;
  421. {
  422.     union value vp,xitpt,vizd,step,to,from,place;
  423.  
  424.     switch(status&XMODE) {
  425.     case M_COMPILE:
  426.     case M_FIXUP: return(p);
  427.     case M_EXECUTE:
  428.         vp = pop();
  429. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  430.         vp.plval = getplace(vp.vpval);
  431. if(dbg) printf(":vp.pl:%o:",vp.plval);
  432.         xitpt = pop();    vizd = pop();    step = pop();
  433.         to = pop();        from = pop();    place = pop();
  434. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  435.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  436. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  437.     xitpt.lval.place,xitpt.lval.codelist->num);
  438.         if(place.plval != vp.plval) FNerror(l,p);
  439.         if(vizd.ival == T_INT)
  440.         place.plval->ival += step.ival;
  441.         else
  442.         place.plval->rval += step.rval;
  443.         push(place);    push(from);    push(to);    
  444.         push(step);        push(vizd);    push(xitpt);
  445.         return(p);
  446.     default: STerror("next");
  447.     }
  448. }
  449.  
  450. /* variables needed for M_READ. */
  451.  
  452. struct line *dlist[DLSIZ];
  453. int dlp = 0;
  454. int dlindx = 2;        /* skips <_data,0> */
  455. int dtype;        /* type of last operation. */
  456.  
  457.  
  458. /* M_COMPILE:
  459.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  460.  * M_FIXUP:
  461.  *    allocates a spot in dlist, stores pointer to llist entry for
  462.  *    this line at that spot.
  463.  * M_EXECUTE:
  464.  *    Returns, with p pointing at the zero, making interp() return.
  465.  */
  466. _data(l,p) int(*l[])(),p;
  467. {
  468.     switch(status&XMODE) {
  469.     case M_COMPILE:
  470.         l[p++] = 0;
  471.         return(p);
  472.     case M_FIXUP:
  473.         dlist[dlp++] = gllentry(l);
  474.         p++;
  475.     case M_EXECUTE: return(p);
  476.     default:
  477.         STerror("data");
  478.     }
  479. }
  480.  
  481. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  482.  */
  483. _dsep(l,p) int(*l[])(),p;
  484. {
  485.     switch(status&XMODE) {
  486.     case M_COMPILE:
  487.     case M_FIXUP:
  488.         l[p++] = 0;
  489.     case M_READ:
  490.     case M_EXECUTE: return(p);
  491.     default: STerror("dsep");
  492.     }
  493. }
  494.  
  495. /* routines for changing the interpretors state. */
  496.  
  497. struct statstk {    /* for saving old states */
  498.     int stkp;
  499.     int stat;
  500. } sstk[30];
  501. int sstktop = 0;
  502.  
  503. /* M_COMPILE:
  504.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  505.  * M_FIXUP:
  506.  *    skip <state>
  507.  * any other state:
  508.  *    save old state and stack pointer.
  509.  *    set state to <state>.
  510.  */
  511. _pushstate(l,p) int (*l[])(),p;
  512. {
  513.     switch(status&XMODE) {
  514.     case M_COMPILE:
  515.         l[p++] = atoi(int_in());
  516.         return(p);
  517.     case M_FIXUP: return(++p);
  518.     default:
  519.         sstk[sstktop].stkp = stackp;
  520.         sstk[sstktop].stat = status;
  521.         sstktop++;
  522.         status = l[p++];
  523.         return(p);
  524.     }
  525. }
  526. _popstate(l,p) int (*l[])(),p;
  527. {
  528.     switch(status&XMODE) {
  529.     case M_COMPILE:
  530.     case M_FIXUP: return(p);
  531.     default:
  532.         sstktop--;
  533.         stackp = sstk[sstktop].stkp;
  534.         status = sstk[sstktop].stat&XMODE;
  535.         return(p);
  536.     }
  537. }
  538.  
  539.  
  540. /* stack maintanence routines.
  541.  */
  542.  
  543.  
  544. /* M_COMPILE:
  545.  *    x spop x    --to--    x,_spop,x
  546.  * M_EXECUTE:
  547.  *    stack: string,x   --to--   x
  548.  *    other: frees storage used by string (if any).
  549.  */
  550. _spop(l,p) int(*l[])(),p;
  551. {
  552.     union value s;
  553.  
  554.     switch(status&XMODE) {
  555.     case M_EXECUTE:
  556.         s=pop();
  557.         if(s.sval != 0) free(s.sval);
  558.     case M_COMPILE: return(p);
  559.     case M_FIXUP: return(p);
  560.     default:
  561.         STerror("spop");
  562.     }
  563. }
  564.  
  565. /* M_COMPILE:
  566.  *    x pop x    --to--    x,_pop,x
  567.  * M_EXECUTE:
  568.  *    stack: int,x    --to--   x
  569.  */
  570. _pop(l,p) int(*l[])(),p;
  571. {
  572.     switch(status&XMODE) {
  573.     case M_FIXUP:
  574.     case M_COMPILE: return(p);
  575.     case M_EXECUTE: pop(); return(p);
  576.     default:
  577.         STerror("pop");
  578.     }
  579. }
  580.  
  581. _stop(l,p) int(*l[])(),p;
  582. {
  583.     switch(status&XMODE) {
  584.     case M_FIXUP:
  585.     case M_COMPILE: return(p);
  586.     case M_EXECUTE: exit(1);
  587.     default:
  588.         STerror("stop");
  589.     }
  590. }
  591. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  592.  
  593.  
  594. /* operator list for the intermediate language. */
  595. struct wlnode wlist[] = {
  596.     "itoa",_itoa,    "print",_print,    "goto",_goto,    "if",_if,  "rtoa",_rtoa,
  597.     "itor",_itor,    "rtoi",_rtoi,    "gosub",_gosub,  "return",_return,
  598.     "scon",_scon,    "icon",_icon,    "i+",_iadd,    "-",_isub,
  599.     "rcon",_rcon,    "r+",_radd,    "r-",_rsub,
  600.     "i*",_imult,    "i/",_idiv,    "i%",_imod,    ",",_comma,
  601.     "r*",_rmult,    "r/",_rdiv,    ";",_scolon,
  602.     "i==",_ieq,    "s==",_seq,    "r==",_req,
  603.     "i<>",_ineq,    "r<>",_rneq,    "s<>",_sneq,
  604.     "i<=",_ileq,    "s<=",_sleq,    "r<=",_rleq,
  605.     "i<",_ilt,    "s<",_slt,    "r<",_rlt,
  606.     "i>=",_igeq,    "s>=",_sgeq,    "r>=",_rgeq,
  607.     "i>",_igt,    "s>",_sgt,    "r>",_rgt,
  608.     "or",_or,    "and",_and,    "val",_val,    "not",_not,
  609.     "pop",_pop,    "spop",_spop,
  610.     "stop",_stop,    "end",_end,    "var",_var,    "store",_store,
  611.     "for",_for,    "next",_next,
  612.     "dlabel",_dlabel,    "rlabel",_rlabel,
  613.     "contin",_contin,  "leave",_leave,  "enter",_enter,  "exitlp",_exitlp,
  614.     "data",_data,    "dsep",_dsep,
  615.     "pushstate",_pushstate,        "popstate",_popstate,
  616.     0,0
  617. };
  618.  
  619. SHAR_EOF
  620. if test 14073 -ne "`wc -c < 'bs2/action.c'`"
  621. then
  622.     echo shar: error transmitting "'bs2/action.c'" '(should have been 14073 characters)'
  623. fi
  624. fi # end of overwriting check
  625. echo shar: extracting "'bs2/bsdefs.h'" '(4472 characters)'
  626. if test -f 'bs2/bsdefs.h'
  627. then
  628.     echo shar: will not over-write existing file "'bs2/bsdefs.h'"
  629. else
  630. sed 's/^X//' << \SHAR_EOF > 'bs2/bsdefs.h'
  631. /* bsdefs.h -- definition file for bs.
  632.  */
  633.  
  634. #include <stdio.h>
  635. #include <ctype.h>
  636.  
  637. /* 'Machine' status */
  638. extern int status;
  639. #define M_COMPILE    (1<<0)
  640. #define M_EXECUTE    (1<<1)
  641. #define M_INPUT        (1<<2)
  642. #define M_FIXUP        (1<<3)
  643. #define M_READ        (1<<4)
  644.  
  645. #define XMODE    (M_COMPILE|M_EXECUTE|M_INPUT|M_FIXUP|M_READ)
  646.  
  647.  
  648. /* line table. */
  649. #define MAXLN    ((unsigned)65535)
  650. #define NUMLINES    1000
  651. #define LASTLINE    (&llist[NUMLINES-1])
  652.  
  653. extern int (*_null[])();
  654.  
  655. struct line {
  656.     unsigned num;
  657.     int (**code)();
  658.     char *text;
  659. };
  660.  
  661. extern struct line llist[];
  662. extern struct line *lastline;
  663. extern struct line *Thisline;
  664. extern int Thisp;
  665.  
  666.  
  667. /* Variable types */
  668. #define Q_NRM    0    /* nice, ordinary variable */
  669. #define Q_ARY    1    /* array */
  670. #define Q_BF    2    /* builtin-function */
  671. #define Q_UFL    3    /* long user function */
  672. #define Q_UFS    4    /* short user function */
  673.  
  674.             /* in type part, a zero value is an undefined type. */
  675. #define T_INT    (1<<6)
  676. #define T_CHR    (2<<6)
  677. #define T_DBL    (3<<6)
  678. #define T_LBL    (4<<6)
  679.  
  680. #define T_QMASK        037        /* lower 5 bits for type qualifier */
  681. #define T_TMASK        (T_INT|T_CHR|T_DBL|T_LBL)
  682.  
  683. /* variable table */
  684. #define VLSIZ    150
  685.  
  686. struct label {
  687.     char *name;
  688.     int (**codelist)();        /* what line it is on */
  689.     int place;            /* where on the line it is. */
  690. };
  691. /* For arrays, storage of them is defined as follows:
  692.  *
  693.  *   1st item: number of dimensions in array <NDIMS>.
  694.  *   next <NDIMS> items: size of each dimension.
  695.  *   rest of items: the actual values.
  696.  *
  697.  * Until we can support varrying sized arrays this is the setup:
  698.  *
  699.  *   1,10,x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10
  700.  *
  701.  * for a total size of 13 items.
  702.  */
  703. union value {
  704.     long ival;        /* T_INT */
  705.     double rval;    /* T_DBL */
  706.     char *sval;        /* T_CHR */
  707.     struct label lval;  /* T_LBL */
  708.     union value *arval; /* any+Q_ARY */
  709.     struct dictnode *vpval; /* for use when pushing variable pointers */
  710.     union value *plval; /* for use when pushing pointers to a value */
  711. };
  712.  
  713. struct dictnode {    /* format of vlist entry */
  714.     char *name;
  715.     int type_of_value;
  716.     union value val;
  717. };
  718.  
  719. extern struct dictnode vlist[];
  720.  
  721. /* '_' Function table */
  722. extern
  723.     _print(),   _goto(),    _if(),    _else(),   _for(),
  724.     _next(),   _read(),    _data(),   _dsep(),   _spop(),
  725.     _pop(),   _stop(),   _end(),   _dlabel(),   _rlabel(),
  726.     _contin(),  _leave(),  _enter(),  _exitlp(),
  727.     _iadd(),   _isub(),   _imult(),   _idiv(),   _imod(),   _comma(),
  728.     _radd(),   _rsub(),   _rmult(),   _rdiv(),
  729.     _scolon(),   _gosub(),   _return(),    _not(),
  730.     _ieq(),        _req(),        _seq(),
  731.     _ineq(),    _rneq(),    _sneq(),
  732.     _ileq(),    _rleq(),    _sleq(),
  733.     _ilt(),        _rlt(),        _slt(),
  734.     _igeq(),    _rgeq(),    _sgeq(),
  735.     _igt(),        _rgt(),        _sgt(),    _or(),        _and(),
  736.     _itoa(),    _rtoa(),    _itor(),    _rtoi(),
  737.     _pushstate(),    _popstate(),
  738.     _scon(),    _rcon(),   _icon(),   _val(),   _store(),   _var();
  739.  
  740. /* interpretor operator table */
  741. struct wlnode {
  742.     char *name;
  743.     int (*funct)();
  744. };
  745.  
  746. extern struct wlnode wlist[];
  747.  
  748. /* Data table.  Array of pointers into llist.  Each is a line wich has data. */
  749. #define DLSIZ    100
  750. extern struct line *dlist[]; /* actual table, number of elems. is DLSIZ */
  751. extern int dlp;        /* index into dlist for current line of data */
  752. extern int dlindx;    /* index into current line for current data item. */
  753. extern int dtype;    /* in M_READ, operators set this to the type of 
  754.              * their operation.  When the expression is done
  755.              * executing, this variable will indicate its type.
  756.              */
  757.  
  758. /* error routines */
  759. extern int ULerror();
  760. extern int STerror();
  761. extern int FNerror();
  762. extern int ODerror();
  763. extern int BDerror();
  764. extern int VTerror();
  765.  
  766.  
  767. /* unions for storing data types in the code list */
  768.  
  769. union doni {
  770.     double d_in_doni;
  771.     int i_in_doni[sizeof(double)/sizeof(int)];
  772. };
  773. union loni {
  774.     long l_in_loni;
  775.     int i_in_loni[sizeof(long)/sizeof(int)];
  776. };
  777. union voni {
  778.     union value v_in_voni;
  779.     int i_in_voni[sizeof(union value)/sizeof(int)];
  780. };
  781.  
  782.  
  783. /* miscellaneous definitions. */
  784.  
  785. #define STKSIZ    500
  786. extern union value stack[];
  787. extern int stackp;
  788. extern int push();
  789. extern union value pop();
  790.  
  791. #define CSTKSIZ    5
  792. #define BFSIZ    200    /* input buffer */
  793. extern char pbbuf[];    /* unput() buffer */
  794. extern char ibuf[];
  795. extern int iptr,pbptr;
  796. extern char input();
  797. extern rdlin(),unput();
  798.  
  799. extern blcpy();
  800.  
  801. extern char bslash();
  802. extern char *scon_in();
  803. extern int num_in();
  804.  
  805. extern char *myalloc();
  806. extern union value *getplace();
  807. extern struct line *gllentry();
  808.  
  809. extern FILE *bsin;
  810.  
  811. extern int dbg;        /* debugging flag. */
  812. extern long atol();
  813. extern double atof();
  814. SHAR_EOF
  815. if test 4472 -ne "`wc -c < 'bs2/bsdefs.h'`"
  816. then
  817.     echo shar: error transmitting "'bs2/bsdefs.h'" '(should have been 4472 characters)'
  818. fi
  819. fi # end of overwriting check
  820. echo shar: extracting "'bs2/bsgram.y'" '(6761 characters)'
  821. if test -f 'bs2/bsgram.y'
  822. then
  823.     echo shar: will not over-write existing file "'bs2/bsgram.y'"
  824. else
  825. sed 's/^X//' << \SHAR_EOF > 'bs2/bsgram.y'
  826.     /* bsgram.y -- grammer specification for bs.
  827.      */
  828. %{
  829. #include "bsdefs.h"
  830.  
  831. char *p;        /* the generic pointer */
  832. int i;            /* the generic counter */
  833.  
  834. struct stk {
  835.     int stack[40];
  836.     int stkp;
  837. };
  838.  
  839. struct stk ifstk,whstk,forstk,repstk,lpstk;
  840. int gomax=0; int ifmax=0; int whmax=0; int formax=0; int repmax=0; int lpmax=0;
  841.  
  842. extern char *yytext;
  843. extern char *bsyysval;
  844. extern int yyleng;
  845. %}
  846.  
  847. %term EQUAL    NEQ    LE    LT    GE    WHILE
  848. %term GT    OR    AND    NOT    RET    REPEAT
  849. %term IF    THEN    ELSE    GOTO    GOSUB    UNTIL
  850. %term STOP    END    INTEGER    REAL    SCONST    ELIHW
  851. %term LET    SWORD    PRINT    INPUT    DATA    CFOR
  852. %term FOR    TO    STEP    READ    WRITE    NEXT
  853. %term DEFINE    LFUN    SFUN    FDEF    SYMBOL    DIM
  854. %term VALUE    IWORD    RWORD    ROFC    LOOP    EXITIF
  855. %term ITOR    RTOI    ITOA    RTOA    LEAVE    CONTINUE
  856. %term POOL
  857.  
  858. %left ',' ';'
  859. %right '='
  860. %nonassoc OR AND
  861. %nonassoc LE LT GE GT EQUAL NEQ
  862. %left '+' '-'
  863. %left '*' '/' '%'
  864. %left UNARY
  865. %left '('
  866.  
  867.  
  868. %start lines
  869.  
  870. %%
  871.  
  872. lines        : /* empty */
  873.         | lines line
  874.         ;
  875.  
  876. line        : lnum stat '\n'
  877.             { printf("\n"); }
  878.         | '\n'
  879.         ;
  880.  
  881. lnum        : INTEGER
  882.             { printf(" line %s ",$1); }
  883.         ;
  884.  
  885. stat        : LET let_xpr
  886.         | let_xpr
  887.         | PRINT pe
  888.             { printf(" print "); }
  889.         | GOTO INTEGER
  890.             { printf(" rlabel LN%s goto ",$2); }
  891.         | GOSUB INTEGER
  892.             { printf(" rlabel LN%s gosub ",$2); }
  893.         | LEAVE
  894.             { printf(" leave "); }
  895.         | CONTINUE
  896.             { printf(" contin "); }
  897.         | RET
  898.             { printf(" return "); }
  899.         | IF bexpr
  900.             {
  901.                 lpush(&ifstk,ifmax);
  902.                 printf(" rlabel IF%d if ",ifmax);
  903.                 ifmax += 2;
  904.             }
  905.           THEN stat
  906.             {
  907.                 i = ltop(&ifstk);
  908.                 printf(" rlabel IF%d goto ",i+1);
  909.             }
  910.           if_else
  911.         | INPUT 
  912.             { printf(" pushstate %d ",M_INPUT); }
  913.           var_lst
  914.             { printf(" popstate "); }
  915.         | STOP
  916.             { printf(" stop "); }
  917.         | END
  918.             { printf(" end "); }
  919.         | FOR ivar '=' rexpr TO rexpr for_step
  920.             {
  921.                 lpush(&forstk,formax);
  922.                 printf(" rlabel FOR%d rlabel FOR%d enter",
  923.                     formax+2,formax+1);
  924.                 printf(" icon 0 rlabel FOR%d dlabel FOR%d for ",
  925.                     formax+1,formax);
  926.                 formax += 3;
  927.             }
  928.         | NEXT
  929.             {
  930.                 i = ltop(&forstk);
  931.                 printf(" dlabel FOR%d ",i+2);
  932.             }
  933.           ivar
  934.             {
  935.                 i = lpop(&forstk);
  936.                 printf(" next rlabel FOR%d goto dlabel FOR%d ",
  937.                     i,i+1);
  938.                 printf("exitlp ");
  939.             }
  940.         | READ { printf(" pushstate %d ",M_READ); } var_lst
  941.             { printf(" popstate "); }
  942.         | DATA { printf(" data "); } data_lst
  943.         | LOOP
  944.             {
  945.                 lpush(&lpstk,lpmax);
  946.                 printf(" rlabel LP%d rlabel LP%d enter",
  947.                     lpmax+2,lpmax+1);
  948.                 printf(" dlabel LP%d ",lpmax);
  949.                 lpmax += 3;
  950.             }
  951.         | EXITIF bexpr
  952.             {
  953.                 i = ltop(&lpstk);
  954.                 printf(" not rlabel LP%d if ",i+1);
  955.             }
  956.         | POOL
  957.             {
  958.                 i = lpop(&lpstk);
  959.                 printf(" dlabel LP%d rlabel LP%d goto",i+2,i);
  960.                 printf(" dlabel LP%d exitlp ",i+1);
  961.             }
  962.         | WHILE
  963.             {
  964.                 lpush(&whstk,whmax);
  965.                 printf(" rlabel WH%d rlabel WH%d enter",
  966.                     whmax+2,whmax+1);
  967.                 printf(" dlabel WH%d ",whmax);
  968.                 whmax += 3;
  969.             }
  970.           bexpr
  971.             {
  972.                 i = ltop(&whstk);
  973.                 printf(" rlabel WH%d if ",i+1);
  974.             }
  975.         | ELIHW
  976.             {
  977.                 i = lpop(&whstk);
  978.                 printf(" dlabel WH%d",i+2);
  979.                 printf(" rlabel WH%d goto dlabel WH%d exitlp ",i,i+1);
  980.             }
  981.         | REPEAT
  982.             {
  983.                 lpush(&repstk,repmax);
  984.                 printf(" rlabel REP%d rlabel REP%d enter",
  985.                     repmax+1,repmax+2);
  986.                 printf(" dlabel REP%d ",repmax);
  987.                 repmax += 3;
  988.             }
  989.         | UNTIL
  990.             {
  991.                 i = ltop(&repstk);
  992.                 printf(" dlabel REP%d ",i+1);
  993.             }
  994.           bexpr
  995.             {
  996.                 i = lpop(&repstk);
  997.                 printf(" not rlabel REP%d if",i);
  998.                 printf(" dlabel REP%d exitlp ",i+2);
  999.             }
  1000.         ;
  1001.  
  1002. let_xpr        : ivar '=' rexpr
  1003.             { printf(" rtoi store %d pop ",T_INT); }
  1004.         | rvar '=' rexpr
  1005.             { printf(" store %d pop ",T_DBL); }
  1006.         | svar '=' sexpr
  1007.             { printf(" store %d spop ",T_CHR); }
  1008.         ;
  1009.  
  1010. data_lst    : rexpr
  1011.             { printf(" dsep "); }
  1012.         | sexpr
  1013.             { printf(" dsep "); }
  1014.         | data_lst ',' rexpr
  1015.             { printf(" dsep "); }
  1016.         | data_lst ',' sexpr
  1017.             { printf(" dsep "); }
  1018.         ;
  1019.  
  1020. ind_lst        : rexpr
  1021.         | ind_lst ',' rexpr
  1022.         ;
  1023.  
  1024. for_step    : /* empty */
  1025.             { printf(" icon 0 "); }
  1026.         | STEP rexpr
  1027.         ;
  1028.  
  1029. if_else        : /* empty */
  1030.             {
  1031.                 i = lpop(&ifstk);
  1032.                 printf(" dlabel IF%d dlabel IF%d ",i,i+1);
  1033.             }
  1034.         | ELSE { i=ltop(&ifstk); printf(" dlabel IF%d ",i); } stat
  1035.             { i=lpop(&ifstk); printf(" dlabel IF%d ",i+1); }
  1036.         ;
  1037.  
  1038.  
  1039. pe        : sexpr ','
  1040.             { printf(" scon \"\" , "); }
  1041.         | sexpr ';'
  1042.         | sexpr
  1043.             { printf(" scon \"\\n\" ; "); }
  1044.         | /* empty */
  1045.             { printf(" scon \"\\n\" "); }
  1046.         ;
  1047.  
  1048.  
  1049. var_lst        : ivar
  1050.         | rvar
  1051.         | svar
  1052.         | var_lst ',' var_lst
  1053.         ;
  1054.  
  1055. sexpr        : SCONST
  1056.             { printf(" scon \"%s\" ",$1); }
  1057.         | svar
  1058.             { printf(" val %d ",T_CHR); }
  1059.         | rexpr
  1060.             { printf(" rtoa "); }
  1061.         | svar '=' sexpr
  1062.             { printf(" store %d ",T_CHR); }
  1063.         | sexpr ';' sexpr
  1064.             { printf(" ; "); }
  1065.         | sexpr '+' sexpr
  1066.             { printf(" ; "); }
  1067.         | sexpr ',' sexpr
  1068.             { printf(" , "); }
  1069.         | '(' sexpr ')'
  1070.         ;
  1071. sbe        : sexpr EQUAL sexpr
  1072.             { printf(" s== "); }
  1073.         | sexpr NEQ sexpr
  1074.             { printf(" s<> "); }
  1075.         | sexpr LE sexpr
  1076.             { printf(" s<= "); }
  1077.         | sexpr LT sexpr
  1078.             { printf(" s< "); }
  1079.         | sexpr GE sexpr
  1080.             { printf(" s>= "); }
  1081.         | sexpr GT sexpr
  1082.             { printf(" s> "); }
  1083.         ;
  1084.  
  1085. ivar        : IWORD
  1086.             { printf(" var %d %s ",T_INT,$1); }
  1087.         | IWORD '(' {printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1088.             { printf(" popstate var %d %s ",T_INT+Q_ARY,$1); }
  1089.         ;
  1090. rvar        : RWORD
  1091.             { printf(" var %d %s ",T_DBL,$1); }
  1092.         | RWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1093.             { printf(" popstate var %d %s ",T_DBL+Q_ARY,$1); }
  1094.         ;
  1095.  
  1096. svar        : SWORD
  1097.             { printf(" var %d %s ",T_CHR,$1); }
  1098.         | SWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1099.             { printf(" popstate var %d %s ",T_CHR+Q_ARY,$1); }
  1100.         ;
  1101.  
  1102.  
  1103.  
  1104. rexpr        : rvar
  1105.             { printf(" val %d ",T_DBL); }
  1106.         | REAL
  1107.             { printf(" rcon %s ",$1); }
  1108.         | INTEGER
  1109.             { printf(" rcon %s ",$1); }
  1110.         | ivar
  1111.             { printf(" val %ditor ",T_INT); }
  1112.         | rvar '=' rexpr
  1113.             { printf(" store %d ",T_DBL); }
  1114.         | '(' rexpr ')'
  1115.         | rexpr '+' rexpr
  1116.             { printf(" r+ "); }
  1117.         | rexpr '-' rexpr
  1118.             { printf(" r- "); }
  1119.         | rexpr '*' rexpr
  1120.             { printf(" r* "); }
  1121.         | rexpr '/' rexpr
  1122.             { printf(" r/ "); }
  1123.         | '+' rexpr    %prec UNARY
  1124.         | '-' rexpr    %prec UNARY
  1125.             { printf(" rcon -1 r* "); }
  1126.         ;
  1127.  
  1128. rbe        : rexpr EQUAL rexpr
  1129.             { printf(" r== "); }
  1130.         | rexpr NEQ rexpr
  1131.             { printf(" r<> "); }
  1132.         | rexpr LE rexpr
  1133.             { printf(" r<= "); }
  1134.         | rexpr LT rexpr
  1135.             { printf(" r< "); }
  1136.         | rexpr GE rexpr
  1137.             { printf(" r>= "); }
  1138.         | rexpr GT rexpr
  1139.             { printf(" r> "); }
  1140.         ;
  1141. bexpr        : sbe
  1142.         | rbe
  1143.         | NOT bexpr    %prec UNARY
  1144.             { printf(" not "); }
  1145.         | bexpr OR bexpr
  1146.             { printf(" or "); }
  1147.         | bexpr AND bexpr
  1148.             { printf(" and "); }
  1149.         | '(' bexpr ')'
  1150.         ;
  1151. %%
  1152.  
  1153. main()
  1154. {
  1155.     rdlin(bsin);
  1156.     return(yyparse());
  1157. }
  1158.  
  1159. yyerror(s)
  1160. char *s;
  1161. {
  1162.     fprintf(stderr,"%s\n",s);
  1163. }
  1164.  
  1165. lpush(stack,val) struct stk *stack; int val;
  1166. { stack->stack[stack->stkp++] = val; }
  1167.  
  1168. int ltop(stack) struct stk *stack;
  1169. { return(stack->stack[stack->stkp-1]); }
  1170.  
  1171. int lpop(stack) struct stk *stack;
  1172. { return(stack->stack[--stack->stkp]); }
  1173. SHAR_EOF
  1174. if test 6761 -ne "`wc -c < 'bs2/bsgram.y'`"
  1175. then
  1176.     echo shar: error transmitting "'bs2/bsgram.y'" '(should have been 6761 characters)'
  1177. fi
  1178. fi # end of overwriting check
  1179. echo shar: extracting "'bs2/bsgram.y.orig'" '(7701 characters)'
  1180. if test -f 'bs2/bsgram.y.orig'
  1181. then
  1182.     echo shar: will not over-write existing file "'bs2/bsgram.y.orig'"
  1183. else
  1184. sed 's/^X//' << \SHAR_EOF > 'bs2/bsgram.y.orig'
  1185.     /* bsgram.y -- grammer specification for bs.
  1186.      */
  1187. %{
  1188. #include "bsdefs.h"
  1189.  
  1190. char *p;        /* the generic pointer */
  1191. int i;            /* the generic counter */
  1192.  
  1193. struct stk {
  1194.     int stack[40];
  1195.     int stkp;
  1196. };
  1197.  
  1198. struct stk ifstk,whstk,forstk,repstk,lpstk;
  1199. int gomax=0; int ifmax=0; int whmax=0; int formax=0; int repmax=0; int lpmax=0;
  1200.  
  1201. extern char *yytext;
  1202. extern char *bsyysval;
  1203. extern int yyleng;
  1204. %}
  1205.  
  1206. %term EQUAL    NEQ    LE    LT    GE    WHILE
  1207. %term GT    OR    AND    NOT    RET    REPEAT
  1208. %term IF    THEN    ELSE    GOTO    GOSUB    UNTIL
  1209. %term STOP    END    INTEGER    REAL    SCONST    ELIHW
  1210. %term LET    SWORD    PRINT    INPUT    DATA    CFOR
  1211. %term FOR    TO    STEP    READ    WRITE    NEXT
  1212. %term DEFINE    LFUN    SFUN    FDEF    SYMBOL    DIM
  1213. %term VALUE    IWORD    RWORD    ROFC    LOOP    EXITIF
  1214. %term ITOR    RTOI    ITOA    RTOA    LEAVE    CONTINUE
  1215. %term POOL
  1216.  
  1217. %left ',' ';'
  1218. %right '='
  1219. %nonassoc OR AND
  1220. %nonassoc LE LT GE GT EQUAL NEQ
  1221. %left '+' '-'
  1222. %left '*' '/' '%'
  1223. %left UNARY
  1224. %left '('
  1225.  
  1226.  
  1227. %start lines
  1228.  
  1229. %%
  1230.  
  1231. lines        : /* empty */
  1232.         | lines line
  1233.         ;
  1234.  
  1235. line        : lnum stat '\n'
  1236.             { printf("\n"); }
  1237.         | '\n'
  1238.         ;
  1239.  
  1240. lnum        : INTEGER
  1241.             { printf(" line %s ",$1); }
  1242.         ;
  1243.  
  1244. stat        : LET let_xpr
  1245.         | let_xpr
  1246.         | PRINT pe
  1247.             { printf(" print "); }
  1248.         | GOTO INTEGER
  1249.             { printf(" rlabel LN%s goto ",$2); }
  1250.         | GOSUB INTEGER
  1251.             { printf(" rlabel LN%s gosub ",$2); }
  1252.         | LEAVE
  1253.             { printf(" leave "); }
  1254.         | CONTINUE
  1255.             { printf(" contin "); }
  1256.         | RET
  1257.             { printf(" return "); }
  1258.         | IF bexpr
  1259.             {
  1260.                 lpush(&ifstk,ifmax);
  1261.                 printf(" rlabel IF%d if ",ifmax);
  1262.                 ifmax += 2;
  1263.             }
  1264.           THEN stat
  1265.             {
  1266.                 i = ltop(&ifstk);
  1267.                 printf(" rlabel IF%d goto ",i+1);
  1268.             }
  1269.           if_else
  1270.         | INPUT { printf(" pushstate %d ",M_INPUT); } var_lst
  1271.             { printf(" popstate "); }
  1272.         | STOP
  1273.             { printf(" stop "); }
  1274.         | END
  1275.             { printf(" end "); }
  1276.         | FOR ivar '=' iexpr TO iexpr for_step
  1277.             {
  1278.                 lpush(&forstk,formax);
  1279.                 printf(" rlabel FOR%d rlabel FOR%d enter",
  1280.                     formax+2,formax+1);
  1281.                 printf(" icon 0 rlabel FOR%d dlabel FOR%d for ",
  1282.                     formax+1,formax);
  1283.                 formax += 3;
  1284.             }
  1285.         | NEXT
  1286.             {
  1287.                 i = ltop(&forstk);
  1288.                 printf(" dlabel FOR%d ",i+2);
  1289.             }
  1290.           ivar
  1291.             {
  1292.                 i = lpop(&forstk);
  1293.                 printf(" next rlabel FOR%d goto dlabel FOR%d ",
  1294.                     i,i+1);
  1295.                 printf("exitlp ");
  1296.             }
  1297.         | READ { printf(" pushstate %d ",M_READ); } var_lst
  1298.             { printf(" popstate "); }
  1299.         | DATA { printf(" data "); } data_lst
  1300.         | LOOP
  1301.             {
  1302.                 lpush(&lpstk,lpmax);
  1303.                 printf(" rlabel LP%d rlabel LP%d enter",
  1304.                     lpmax+2,lpmax+1);
  1305.                 printf(" dlabel LP%d ",lpmax);
  1306.                 lpmax += 3;
  1307.             }
  1308.         | EXITIF bexpr
  1309.             {
  1310.                 i = ltop(&lpstk);
  1311.                 printf(" not rlabel LP%d if ",i+1);
  1312.             }
  1313.         | POOL
  1314.             {
  1315.                 i = lpop(&lpstk);
  1316.                 printf(" dlabel LP%d rlabel LP%d goto",i+2,i);
  1317.                 printf(" dlabel LP%d exitlp ",i+1);
  1318.             }
  1319.         | WHILE
  1320.             {
  1321.                 lpush(&whstk,whmax);
  1322.                 printf(" rlabel WH%d rlabel WH%d enter",
  1323.                     whmax+2,whmax+1);
  1324.                 printf(" dlabel WH%d ",whmax);
  1325.                 whmax += 3;
  1326.             }
  1327.           bexpr
  1328.             {
  1329.                 i = ltop(&whstk);
  1330.                 printf(" rlabel WH%d if ",i+1);
  1331.             }
  1332.         | ELIHW
  1333.             {
  1334.                 i = lpop(&whstk);
  1335.                 printf(" dlabel WH%d",i+2);
  1336.                 printf(" rlabel WH%d goto dlabel WH%d exitlp ",i,i+1);
  1337.             }
  1338.         | REPEAT
  1339.             {
  1340.                 lpush(&repstk,repmax);
  1341.                 printf(" rlabel REP%d rlabel REP%d enter",
  1342.                     repmax+1,repmax+2);
  1343.                 printf(" dlabel REP%d ",repmax);
  1344.                 repmax += 3;
  1345.             }
  1346.         | UNTIL
  1347.             {
  1348.                 i = ltop(&repstk);
  1349.                 printf(" dlabel REP%d ",i+1);
  1350.             }
  1351.           bexpr
  1352.             {
  1353.                 i = lpop(&repstk);
  1354.                 printf(" not rlabel REP%d if",i);
  1355.                 printf(" dlabel REP%d exitlp ",i+2);
  1356.             }
  1357.         ;
  1358.  
  1359. let_xpr        : ivar '=' iexpr
  1360.             { printf(" store %d pop ",T_INT); }
  1361.         | rvar '=' rexpr
  1362.             { printf(" store %d pop ",T_DBL); }
  1363.         | svar '=' sexpr
  1364.             { printf(" store %d spop ",T_CHR); }
  1365.         ;
  1366.  
  1367. data_lst    : iexpr
  1368.             { printf(" dsep "); }
  1369.         | rexpr
  1370.             { printf(" dsep "); }
  1371.         | sexpr
  1372.             { printf(" dsep "); }
  1373.         | data_lst ',' iexpr
  1374.             { printf(" dsep "); }
  1375.         | data_lst ',' rexpr
  1376.             { printf(" dsep "); }
  1377.         | data_lst ',' sexpr
  1378.             { printf(" dsep "); }
  1379.         ;
  1380.  
  1381. ind_lst        : iexpr
  1382.         | ind_lst ',' iexpr
  1383.         ;
  1384.  
  1385. for_step    : /* empty */
  1386.             { printf(" icon 0 "); }
  1387.         | STEP iexpr
  1388.         ;
  1389.  
  1390. if_else        : /* empty */
  1391.             {
  1392.                 i = lpop(&ifstk);
  1393.                 printf(" dlabel IF%d dlabel IF%d ",i,i+1);
  1394.             }
  1395.         | ELSE { i=ltop(&ifstk); printf(" dlabel IF%d ",i); } stat
  1396.             { i=lpop(&ifstk); printf(" dlabel IF%d ",i+1); }
  1397.         ;
  1398.  
  1399.  
  1400. pe        : sexpr ','
  1401.             { printf(" scon \"\" , "); }
  1402.         | sexpr ';'
  1403.         | sexpr
  1404.             { printf(" scon \"\\n\" ; "); }
  1405.         | /* empty */
  1406.             { printf(" scon \"\\n\" "); }
  1407.         ;
  1408.  
  1409.  
  1410. var_lst        : ivar
  1411.         | rvar
  1412.         | svar
  1413.         | var_lst ',' var_lst
  1414.         ;
  1415.  
  1416. sexpr        : SCONST
  1417.             { printf(" scon \"%s\" ",$1); }
  1418.         | svar
  1419.             { printf(" val %d ",T_CHR); }
  1420.         | iexpr
  1421.             { printf(" itoa "); }
  1422.         | rexpr
  1423.             { printf(" rtoa "); }
  1424.         | svar '=' sexpr
  1425.             { printf(" store %d ",T_CHR); }
  1426.         | sexpr ';' sexpr
  1427.             { printf(" ; "); }
  1428.         | sexpr '+' sexpr
  1429.             { printf(" ; "); }
  1430.         | sexpr ',' sexpr
  1431.             { printf(" , "); }
  1432.         | '(' sexpr ')'
  1433.         ;
  1434. sbe        : sexpr EQUAL sexpr
  1435.             { printf(" s== "); }
  1436.         | sexpr NEQ sexpr
  1437.             { printf(" s<> "); }
  1438.         | sexpr LE sexpr
  1439.             { printf(" s<= "); }
  1440.         | sexpr LT sexpr
  1441.             { printf(" s< "); }
  1442.         | sexpr GE sexpr
  1443.             { printf(" s>= "); }
  1444.         | sexpr GT sexpr
  1445.             { printf(" s> "); }
  1446.         ;
  1447.  
  1448. ivar        : IWORD
  1449.             { printf(" var %d %s ",T_INT,$1); }
  1450.         | IWORD '(' {printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1451.             { printf(" popstate var %d %s ",T_INT+Q_ARY,$1); }
  1452.         ;
  1453. rvar        : RWORD
  1454.             { printf(" var %d %s ",T_DBL,$1); }
  1455.         | RWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1456.             { printf(" popstate var %d %s ",T_DBL+Q_ARY,$1); }
  1457.         ;
  1458.  
  1459. svar        : SWORD
  1460.             { printf(" var %d %s ",T_CHR,$1); }
  1461.         | SWORD '(' { printf(" pushstate %d ",M_EXECUTE); } ind_lst ')'
  1462.             { printf(" popstate var %d %s ",T_CHR+Q_ARY,$1); }
  1463.         ;
  1464.  
  1465. iexpr        : ivar
  1466.             { printf(" val %d ",T_INT); }
  1467.         | INTEGER
  1468.             { printf(" icon %s ",$1); }
  1469.         | REAL
  1470.             { printf(" rcon %s rtoi ",$1); }
  1471.         | ivar '=' iexpr
  1472.             { printf(" store %d ",T_INT); }
  1473.         | RTOI '(' rexpr ')'
  1474.             { printf(" rtoi "); }
  1475.         | '(' iexpr ')'
  1476.         | iexpr '+' iexpr
  1477.             { printf(" i+ "); }
  1478.         | iexpr '-' iexpr
  1479.             { printf(" i- "); }
  1480.         | iexpr '*' iexpr
  1481.             { printf(" i* "); }
  1482.         | iexpr '/' iexpr
  1483.             { printf(" i/ "); }
  1484.         | iexpr '%' iexpr
  1485.             { printf(" i%% "); }
  1486.         | '+' iexpr    %prec UNARY
  1487.         | '-' iexpr    %prec UNARY
  1488.             { printf(" icon -1 i* "); }
  1489.         ;
  1490.  
  1491. ibe        : iexpr EQUAL iexpr
  1492.             { printf(" i== "); }
  1493.         | iexpr NEQ iexpr
  1494.             { printf(" i<> "); }
  1495.         | iexpr LE iexpr
  1496.             { printf(" i<= "); }
  1497.         | iexpr LT iexpr
  1498.             { printf(" i< "); }
  1499.         | iexpr GE iexpr
  1500.             { printf(" i>= "); }
  1501.         | iexpr GT iexpr
  1502.             { printf(" i> "); }
  1503.         ;
  1504.  
  1505. rexpr        : rvar
  1506.             { printf(" val %d ",T_DBL); }
  1507.         | REAL
  1508.             { printf(" rcon %s ",$1); }
  1509.         | INTEGER
  1510.             { printf(" rcon %s ",$1); }
  1511.         | rvar '=' rexpr
  1512.             { printf(" store %d ",T_DBL); }
  1513.         | ITOR '(' iexpr ')'
  1514.             { printf(" itor "); }
  1515.         | '(' rexpr ')'
  1516.         | rexpr '+' rexpr
  1517.             { printf(" r+ "); }
  1518.         | rexpr '-' rexpr
  1519.             { printf(" r- "); }
  1520.         | rexpr '*' rexpr
  1521.             { printf(" r* "); }
  1522.         | rexpr '/' rexpr
  1523.             { printf(" r/ "); }
  1524.         | '+' rexpr    %prec UNARY
  1525.         | '-' rexpr    %prec UNARY
  1526.             { printf(" rcon -1 r* "); }
  1527.         ;
  1528.  
  1529. rbe        : rexpr EQUAL rexpr
  1530.             { printf(" r== "); }
  1531.         | rexpr NEQ rexpr
  1532.             { printf(" r<> "); }
  1533.         | rexpr LE rexpr
  1534.             { printf(" r<= "); }
  1535.         | rexpr LT rexpr
  1536.             { printf(" r< "); }
  1537.         | rexpr GE rexpr
  1538.             { printf(" r>= "); }
  1539.         | rexpr GT rexpr
  1540.             { printf(" r> "); }
  1541.         ;
  1542. bexpr        : sbe
  1543.         | ibe
  1544.         | rbe
  1545.         | NOT bexpr    %prec UNARY
  1546.             { printf(" not "); }
  1547.         | bexpr OR bexpr
  1548.             { printf(" or "); }
  1549.         | bexpr AND bexpr
  1550.             { printf(" and "); }
  1551.         | '(' bexpr ')'
  1552.         ;
  1553. %%
  1554.  
  1555. main()
  1556. {
  1557.     rdlin(bsin);
  1558.     return(yyparse());
  1559. }
  1560.  
  1561. yyerror(s)
  1562. char *s;
  1563. {
  1564.     fprintf(stderr,"%s\n",s);
  1565. }
  1566.  
  1567. lpush(stack,val) struct stk *stack; int val;
  1568. { stack->stack[stack->stkp++] = val; }
  1569.  
  1570. int ltop(stack) struct stk *stack;
  1571. { return(stack->stack[stack->stkp-1]); }
  1572.  
  1573. int lpop(stack) struct stk *stack;
  1574. { return(stack->stack[--stack->stkp]); }
  1575. SHAR_EOF
  1576. if test 7701 -ne "`wc -c < 'bs2/bsgram.y.orig'`"
  1577. then
  1578.     echo shar: error transmitting "'bs2/bsgram.y.orig'" '(should have been 7701 characters)'
  1579. fi
  1580. fi # end of overwriting check
  1581. echo shar: extracting "'bs2/bsint.c'" '(12093 characters)'
  1582. if test -f 'bs2/bsint.c'
  1583. then
  1584.     echo shar: will not over-write existing file "'bs2/bsint.c'"
  1585. else
  1586. sed 's/^X//' << \SHAR_EOF > 'bs2/bsint.c'
  1587. /* bsint.c -- main part of interpretor.
  1588.  */
  1589.  
  1590. #include "bsdefs.h"
  1591.  
  1592. int (*_null[])() = { 0,0 };
  1593.  
  1594. struct line llist[NUMLINES] = {
  1595.     0, _null, "",
  1596.     MAXLN, _null, ""
  1597. };
  1598.  
  1599. struct line *lastline = &llist[1];
  1600. struct line *Thisline = &llist[0];
  1601. int Thisp = 0;
  1602.  
  1603. struct dictnode vlist[VLSIZ];
  1604.  
  1605.  
  1606. /* bslash() -- have seen '\', use input() to say what is actually wanted.
  1607.  */
  1608. char bslash()
  1609. {
  1610.     char text[8];
  1611.     register char *s,c;
  1612.     int v;
  1613.  
  1614.     c=input();
  1615.     if(c == 'n') c='\n';
  1616.     else if(c == 't') c='\t';
  1617.     else if(c == 'b') c='\b';
  1618.     else if(c == 'r') c='\r';
  1619.     else if(c == 'f') c='\f';
  1620.     else if(c>='0' && c<='7') { /* octal digit string */
  1621.     s = &text[0];
  1622.     *s++ = c;
  1623.     c=input();
  1624.     while(c>='0' && c<='7') {
  1625.         *s++ = c;
  1626.         c=input();
  1627.     }
  1628.     *s++ = '\0';
  1629.     sscanf(text,"%o",&v);
  1630.     c = (char) v;
  1631.     }
  1632.     else if(c=='\n') rdlin(bsin);
  1633.     return(c);
  1634. }
  1635.  
  1636.  
  1637. /* scon_in() -- read in a string constant using input.
  1638.  *    Format of an scon is either a quoted string, or a sequence
  1639.  *    of characters ended with a seperator (' ', '\t' or '\n' or ',').
  1640.  *
  1641.  *    In either mode, you can get funny characters into the string by
  1642.  *    "quoting" them with a '\'.
  1643.  *
  1644.  * scon_in() uses myalloc() to create space to store the string in.
  1645.  */
  1646. char *scon_in()
  1647. {
  1648.     register char c,*s;
  1649.     static char text [80];
  1650.  
  1651.     s = &text[0];
  1652.  
  1653. /* beginning state, skip seperators until something interesting comes along */
  1654.  
  1655. l1: c=input();
  1656.     if(c == '"') goto l2;
  1657.     else if(c=='\n' || c=='\0') {
  1658.     rdlin(bsin);
  1659.     goto l1;
  1660.     }
  1661.     else if(c==' ' || c=='\t' || c==',') goto l1;
  1662.     else goto l3;
  1663.  
  1664. /* have skipped unwanted material, seen a '"', read in a quoted string */
  1665.  
  1666. l2: c=input();
  1667.     if(c == '\n') {
  1668.     fprintf(stderr,"scon_in: unterminated string\n");
  1669.     exit(1);
  1670.     }
  1671.     else if(c == '\\') { *s++ = bslash(bsin); goto l2; }
  1672.     else if(c == '"')
  1673.     if((c=input()) == '"') {
  1674.         *s++ = '"';
  1675.         goto l2;
  1676.     }
  1677.     else goto done;
  1678.     else { *s++ = c; goto l2; }
  1679.  
  1680. /* skipped unwanted, seen something interesting, not '"', gather until sep */
  1681.  
  1682. l3: *s++ = c;
  1683.     c=input();
  1684.     if(c == '\\') { c = bslash(bsin); goto l3; }
  1685.     else if(c==' ' || c=='\t' || c==',' || c=='\n') goto done;
  1686.     else goto l3;
  1687.  
  1688. /* final state (if machine finished ok.) */
  1689.  
  1690. done: unput(c);
  1691.     *s++ = '\0';
  1692.     s=myalloc(strlen(text)+1);
  1693.     strcpy(s,text);
  1694.     return(s);
  1695. }
  1696.  
  1697. /* int_in() -- tokenizer routine for inputting a number.
  1698.  * int_in() returns a pointer to a static data area.  This area gets 
  1699.  * overwritten with each call to int_in so use the data before calling
  1700.  * int_in() again.
  1701.  */
  1702. char * int_in()
  1703. {
  1704.     register char c,*s;
  1705.     static char text[20];
  1706.  
  1707.     s = &text[0];
  1708.  
  1709. /* beginning state, skip junk until either '-' or ['0'-'9'] comes along */
  1710.  
  1711. l1: c=input();
  1712.     if(c>='0' && c<='9') goto l3;
  1713.     else if(c == '-') goto l2;
  1714.     else {
  1715.     if(c=='\n' || c=='\0') rdlin(bsin);
  1716.     goto l1;
  1717.     }
  1718.  
  1719. /* skipped junk, seen '-', gather it and make sure next char is a digit */
  1720.  
  1721. l2: *s++ = c;
  1722.     c=input();
  1723.     if(c==' ' || c=='\t') goto l2; /* allow white between sign and digit */
  1724.     else if(c>='0' && c<='9') goto l3;
  1725.     else { /* seen something not allowed. */
  1726.     s = &text[0];
  1727.     printf("\n\007??");
  1728.     goto l1; /* restart machine */
  1729.     }
  1730.  
  1731. /* skipped junk, seen a digit, gather until a non-digit appears */
  1732.  
  1733. l3: *s++ = c;
  1734.     c=input();
  1735.     if(c>='0' && c<='9') goto l3;
  1736.     else {
  1737.     /* have reached successful conclusion to machine. */
  1738.     unput(c);
  1739.     *s++ = '\0';
  1740.     return(text);
  1741.     }
  1742. }
  1743.  
  1744. /* real_in() -- read in a floating point number using input().
  1745.  *
  1746.  * real_in() returns a pointer to a static data area.  This data area
  1747.  * gets overwritten with each call to real_in(), so use it quickly.
  1748.  */
  1749. char *real_in()
  1750. {
  1751.     register char *s,c;
  1752.     static char bf[30];
  1753.  
  1754.     s = &bf[0];
  1755.  
  1756. /* starting state.  loops back until something interesting seen */
  1757.  
  1758. state1:    c=input();
  1759.     if(c == '-') goto state3;
  1760.     else if(c>='0' && c<='9') goto state2;
  1761.     else if(c == '.') goto state4;
  1762.     else {
  1763.         if(c=='\n' || c=='\0') rdlin(bsin);
  1764.         goto state1;
  1765.     }
  1766.  
  1767. /* seen a digit.  gather all digits following. */
  1768.  
  1769. state2: *s++ = c;
  1770.     c=input();
  1771.     if(c>='0' && c<='9') goto state2;
  1772.     else if(c == '.') goto state4;
  1773.     else goto state9;    /* done */
  1774.  
  1775. /* seen a sign character before start of number.  loop back for whitespace. */
  1776.  
  1777. state3: *s++ = c;
  1778. state3_a: c=input();
  1779.     if(c==' ' || c=='\t') goto state3_a;
  1780.     else if(c>='0' && c<='9') goto state2;
  1781.     else if(c == '.') goto state4;
  1782.     else goto state10;    /* error, had a sign so we have to have digs. */
  1783.  
  1784. /* seen digit(s) and a decimal point. looking for more digs or ('e'|'E') */
  1785.  
  1786. state4: *s++ = c;
  1787.     c=input();
  1788.     if(c>='0' && c<='9') goto state5;
  1789.     else if(c=='e' || c=='E') goto state6;
  1790.     else goto state9;    /* done */
  1791.  
  1792. /* seen (digs '.' dig).  look for more digs or ('e'|'E'). */
  1793.  
  1794. state5:    *s++ = c;
  1795.     c=input();
  1796.     if(c=='e' || c=='E') goto state6;
  1797.     else if(c>='0' && c<='9') goto state5;
  1798.     else goto state9;
  1799.  
  1800. /* seen (digs '.' digs (e|E)). looking for sign or digs, else error. */
  1801.  
  1802. state6: *s++ = c;
  1803.     c=input();
  1804.     if(c=='+' || c=='-') goto state7;
  1805.     else if(c>='0' && c<='9') goto state8;
  1806.     else goto state10;    /* error */
  1807.  
  1808. /* seen (digs '.' digs (e|E) sign). looking for digs, else error. */
  1809.  
  1810. state7: *s++ = c;
  1811.     c=input();
  1812.     if(c>='0' && c<='9') goto state8;
  1813.     else goto state10;    /* error */
  1814.  
  1815. /* seen (digs '.' digs (e|E) [sign] dig). looking for digs. */
  1816.  
  1817. state8: *s++ = c;
  1818.     c=input();
  1819.     if(c>='0' && c<='9') goto state8;
  1820.     else goto state9;    /* done */
  1821.  
  1822. /* seen a complete number.  machine successfully completed.  whew! */
  1823.  
  1824. state9: unput(c);    /* might want that later */
  1825.     *s++ = '\0';
  1826.     return(bf);
  1827.  
  1828. /* Uh oh.  An error.  Print an error and restart. */
  1829.  
  1830. state10: printf("\n\007??");
  1831.     goto state1;
  1832. }
  1833.  
  1834. /* gtok() -- read a token using input().  Tokens are delimited by whitespace.
  1835.  *    When '\n' is found, "\n" is returned.
  1836.  *    For EOF or control characters (not '\n' or '\t') 0 is returned.
  1837.  */
  1838. char *gtok()
  1839. {
  1840.     static char token[20];
  1841.     register char *s,c;
  1842.  
  1843.     s = &token[0];
  1844. loop: c=input();
  1845.     if(c==' ' || c=='\t') goto loop;
  1846.     else if(c == '\n') return("\n");
  1847.     else if(c==EOF || iscntrl(c)) return(0);
  1848.     else {
  1849.     *s++ = c;
  1850.     for(c=input(); c>' ' && c<='~'; c=input())
  1851.         *s++ = c;
  1852.     unput(c);
  1853.     *s++ = '\0';
  1854.     return(token);
  1855.     }
  1856. }
  1857.  
  1858. /* insline(num) -- insert num into llist with insertion sort style.
  1859.  *    Replaces old lines if already in list.
  1860.  */
  1861. struct line *insline(num)
  1862. int num;
  1863. {
  1864.     struct line *p,*p2,*p3;
  1865.     struct dictnode *vp;
  1866.     struct dictnode *gvadr();
  1867.     char s[12];
  1868.  
  1869.     if(lastline == LASTLINE) return(0);
  1870.     for(p=lastline; p->num > num; p--)
  1871.     /* null */ ;
  1872.     if(p->num == num) {
  1873.     if(p->code != 0) { free(p->code); p->code = 0; }
  1874.     if(p->text != 0) { free(p->text); p->text = 0; }
  1875.     }
  1876.     else { /* p->num < num */
  1877.     ++p;
  1878.     p2=lastline;
  1879.     p3= ++lastline;
  1880.     while(p2 >= p) {
  1881.         p3->num = p2->num;
  1882.         p3->code = p2->code;
  1883.         p3->text = p2->text;
  1884.         p2--;
  1885.         p3--;
  1886.     }
  1887.     p->num = num;
  1888.     p->text = p->code = 0;
  1889.     }
  1890.     sprintf(s,"LN%d",num);
  1891.     vp = gvadr(s,T_LBL);
  1892.     vp->val.lval.codelist = p;
  1893.     vp->val.lval.place = 0;
  1894.     return(p);
  1895. }
  1896.  
  1897. /* gvadr() -- Get variable address from vlist, with type checking.
  1898.  *    This routine allows numerous copies of same name as long as
  1899.  *    all copies have different types.  Probably doesnt matter since
  1900.  *    the parser does the type checking.
  1901.  */
  1902. struct dictnode *gvadr(s,ty)
  1903. char *s;
  1904. int ty;
  1905. {
  1906.     register int i;
  1907.     register int qual; /* type qualifier */
  1908.  
  1909.     for(i=0; vlist[i].name!=0 && i<VLSIZ; i++)
  1910.     if(vlist[i].type_of_value==ty && strcmp(s,vlist[i].name)==0)
  1911.         break; /* match found */
  1912.     if(i >= VLSIZ) {
  1913.     fprintf(stderr,"gvadr: out of room in variable list for %s\n",s);
  1914.     exit(1);
  1915.     }
  1916.     if(vlist[i].name == 0) { /* not on list, enter it */
  1917.     vlist[i].name = myalloc(strlen(s)+1);
  1918.     strcpy(vlist[i].name,s);
  1919.     vlist[i].val.rval = 0;
  1920.     vlist[i].type_of_value = ty;
  1921.     if(ty&T_QMASK == Q_ARY)
  1922.         vlist[i].val.arval = myalloc(13*sizeof(union value));
  1923.     }
  1924.     return(&vlist[i]);
  1925. }
  1926.  
  1927. /* getplace() -- get a pointer to place of value for vlist entry on top of stack
  1928.  *    For arrays, getplace() expects the indexes to be on the stack as well.
  1929.  *    The parser should properly arrange for this to happen.
  1930.  */
  1931. union value *getplace(dp)
  1932. struct dictnode *dp;
  1933. {
  1934.     int qual;
  1935.     union value ind,*place;
  1936.  
  1937.     qual = dp->type_of_value&T_QMASK;
  1938.     if(qual == Q_ARY) {
  1939.     ind = pop();
  1940.     mpop();
  1941.     place = & dp->val.arval[ind.ival+2];
  1942.     }
  1943.     else
  1944.     place = & dp->val;
  1945.     return(place);
  1946. }
  1947.  
  1948. /* gladr() -- get address of llist entry, given the line number.
  1949.  */
  1950. struct line *gladr(lnum)
  1951. unsigned lnum;
  1952. {
  1953.     register struct line *q;
  1954.     register int num;
  1955.  
  1956.     num = lnum;
  1957.     for(q= &llist[0]; q->num!=num && q->num!=MAXLN ; q++)
  1958.         ;
  1959.     if(q->num == MAXLN) return(0);
  1960.     /* else */
  1961.     if(q->code==0 && q->text==0) return(0); /* fake line */
  1962.     /* else */
  1963.     return(q); /* found place */
  1964. }
  1965.  
  1966. /* gllentry() -- Given an address for a code list, return llist entry which
  1967.  *    has matching code list address.
  1968.  */
  1969. struct line *gllentry(l)
  1970. int **l;
  1971. {
  1972.     register int llp;
  1973.  
  1974.     for(llp=0; llist[llp].num != MAXLN; llp++)
  1975.     if(llist[llp].code == l)
  1976.         return(&llist[llp]);
  1977.  
  1978.     return(0);    /* such an entry not found */
  1979. }
  1980.  
  1981. /* glist() -- read rest of line as a code list, return the corresponding
  1982.  *    code list.
  1983.  */
  1984. int **glist()
  1985. {
  1986.     register char *s;
  1987.     int (*codestring[100])();
  1988.     int lp,(**l)();
  1989.     register int i;
  1990.  
  1991.     lp=0;
  1992.     for(s=gtok(); s!=0 && strcmp(s,"\n")!=0; s=gtok()) {
  1993.     for(i=0; wlist[i].name!=0; i++)
  1994.         if(strcmp(wlist[i].name,s)==0)
  1995.         break;
  1996.     if(wlist[i].name == 0) {
  1997.         fprintf(stderr,"unknown name %s\n",s);
  1998.         exit(1);
  1999.     }
  2000.     if(wlist[i].funct == 0) {
  2001.         fprintf(stderr,"glist: no function for %s at %o\n",s,&wlist[i]);
  2002.         exit(1);
  2003.     }
  2004.     codestring[lp++] = wlist[i].funct;
  2005.     lp = (*wlist[i].funct)(codestring,lp);
  2006.     }
  2007.     codestring[lp++] = 0;
  2008.     l = myalloc(lp*2+1);
  2009.     blcpy(l,codestring,lp*2);
  2010.     return(l);
  2011. }
  2012.  
  2013. /* rprg -- read in a bunch of lines, put them in program buffer.
  2014.  */
  2015. rprg()
  2016. {
  2017.     char *s;
  2018.     int ln;
  2019.     struct line *pl;
  2020.  
  2021.     for(s=gtok(); s!=0; s=gtok()) {
  2022.     if(strcmp(s,"line") == 0) {
  2023.         s=gtok();
  2024.         ln=atoi(s);
  2025.         pl=insline(ln);
  2026.         if(pl == 0){ fprintf(stderr,"out of room for program\n");exit(1); }
  2027.         s=myalloc(strlen(ibuf)+1);
  2028.         strcpy(s,ibuf);
  2029.         pl->text = s;
  2030.         pl->code = glist();
  2031.     }
  2032.     else { fprintf(stderr,"syntax error, no line number: %s\n",ibuf); exit(1); }
  2033.     }
  2034. }
  2035.  
  2036.  
  2037. interp(l,start)
  2038. int (*l[])(),start;
  2039. {
  2040.     int lp;
  2041.     for(lp=start+1; l[lp-1]!=0; lp++)
  2042.     lp = (*l[lp-1])(l,lp);
  2043.     return(lp);
  2044. }
  2045.  
  2046. /* runit() -- run the program in llist.  arg- address of place to start at.
  2047.  *
  2048.  * to do a goto type action, set Thisline to llist entry PREVIOUS to 
  2049.  * desired place.  Set Thisp to desired index.  To cause it to happen,
  2050.  * place a 0 in the code list where interp() will see it at the right
  2051.  * time.
  2052.  *
  2053.  * All this will cause runit() to run correctly, and automatically take
  2054.  * care of updating the line number pointers (Thisline and Thisp).
  2055.  */
  2056. runit()
  2057. {
  2058.     int ourthisp;
  2059.  
  2060.     ourthisp = Thisp;
  2061.     Thisp = 0;
  2062.     while(Thisline < lastline) {
  2063.     interp((Thisline->code),ourthisp);
  2064.     ++Thisline;
  2065.     ourthisp = Thisp;
  2066.     Thisp = 0;
  2067.     }
  2068. }
  2069.  
  2070. int dbg = 0;    /* debugging flag. */
  2071. main(argc,argv)
  2072. int argc;
  2073. char **argv;
  2074. {
  2075.     int i,j;
  2076.     int (**l)();
  2077.  
  2078.     if(argc >= 2) {
  2079.     if((bsin=fopen(argv[1],"r")) == NULL) {
  2080.         fprintf(stderr,"main: could not open input file %s\n",argv[1]);
  2081.         exit(1);
  2082.     }
  2083.     }
  2084.     if(argc > 2) dbg = 1;    /* "int file <anything>" sets debugging */
  2085.  
  2086.     /* Read the program (on file bsin) and compile it to the executable code. */
  2087.     rdlin(bsin);
  2088.     status = M_COMPILE;
  2089.     rprg();
  2090.     if(bsin != stdin) fclose(bsin);
  2091.     bsin = stdin;    /* make sure it is stdin for execution */
  2092.     iptr = 0;
  2093.     ibuf[iptr] = 0;    /* make the input buffer empty. */
  2094.  
  2095.     /* Scan through the compiled code, make sure things point to where
  2096.      * they are supposed be pointing to, etc.
  2097.      */
  2098.     status = M_FIXUP;
  2099.     Thisline = &llist[0];
  2100.     while(Thisline < lastline) {
  2101.     interp((Thisline->code),0);
  2102.     ++Thisline;
  2103.     }
  2104.  
  2105.     status = M_EXECUTE;
  2106.     dlp = 0;    /* set it back to beginning of list */
  2107.     Thisline = &llist[0];
  2108.     Thisp = 0;
  2109.     runit();
  2110. }
  2111. SHAR_EOF
  2112. if test 12093 -ne "`wc -c < 'bs2/bsint.c'`"
  2113. then
  2114.     echo shar: error transmitting "'bs2/bsint.c'" '(should have been 12093 characters)'
  2115. fi
  2116. fi # end of overwriting check
  2117. echo shar: extracting "'bs2/bslib.c'" '(1553 characters)'
  2118. if test -f 'bs2/bslib.c'
  2119. then
  2120.     echo shar: will not over-write existing file "'bs2/bslib.c'"
  2121. else
  2122. sed 's/^X//' << \SHAR_EOF > 'bs2/bslib.c'
  2123. /* bslib.c -- subroutine library, routines useful anywhere.
  2124.  */
  2125.  
  2126. #include "bsdefs.h"
  2127.  
  2128. XFILE *bsin = stdin;
  2129.  
  2130. /* blcpy -- copies a block of memory (l bytes) from s to d.
  2131.  */
  2132. blcpy(d,s,l)
  2133. char *d,*s;
  2134. int l;
  2135. {
  2136.     for(; l >= 0; (l--)) *(d++) = *(s++);
  2137. }
  2138.  
  2139. /* Input routines.  These routines buffer input a line at a time into
  2140.  * ibuf.  Unputted input goes to pbbuf, and gets read before things in
  2141.  * ibuf, if anything in pbbuf.
  2142.  */
  2143.  
  2144. char pbbuf[CSTKSIZ],ibuf[BFSIZ];
  2145.  
  2146. int iptr = -1;
  2147. int pbptr = -1;
  2148.  
  2149. char input()
  2150. {
  2151.     if(pbptr > -1)
  2152.     return(pbbuf[pbptr--]);
  2153.     else {
  2154.     if(ibuf[iptr] == '\0') rdlin(bsin);
  2155.     if(ibuf[iptr]!='\0' && !feof(bsin))
  2156.         return(ibuf[iptr++]);
  2157.     else
  2158.         return(0);
  2159.     }
  2160. }
  2161.  
  2162. rdlin(f) FILE *f;
  2163. {
  2164.     char c;
  2165.  
  2166.     iptr = 0;
  2167.     for(c=fgetc(f); c!='\n' && c!=EOF; c=fgetc(f)) ibuf[iptr++] = c;
  2168.     ibuf[iptr++] = c;
  2169.     ibuf[iptr++] = '\0';
  2170.     iptr = 0;
  2171. }
  2172.  
  2173. unput(c) char c;
  2174. { pbbuf[++pbptr] = c; }
  2175.  
  2176. /* myalloc() -- allocate, checking for out of memory.
  2177.  */
  2178. char *myalloc(nb)
  2179. int nb;
  2180. {
  2181.     char *rval;
  2182.     rval = malloc(nb);
  2183. /*
  2184.     printf("myalloc:tos:%o,rv:%o,nb:%d,e:%o\n",&rval,rval,nb,sbrk(0));
  2185. */
  2186.     if(rval == 0) {
  2187.     fprintf(stderr,"myalloc: out of memory\n");
  2188.     exit(1);
  2189.     }
  2190.     return(rval);
  2191. }
  2192.  
  2193.  
  2194.  
  2195. /* Stack routines.  Very simple. */
  2196.  
  2197. union value stack[STKSIZ];
  2198. int stackp = -1;
  2199.  
  2200. push(i) union value i;
  2201. {
  2202.     stack[++stackp] = i;
  2203. }
  2204.  
  2205. union value pop()
  2206. {
  2207.     return(stack[stackp--]);
  2208. }
  2209.  
  2210. /* Mark stack.  Also very simple. */
  2211. int mstack[5];
  2212. int mstkp = -1;
  2213. mpush()
  2214. { mstack[++mstkp] = stackp; }
  2215. mpop()
  2216. { stackp = mstack[mstkp--]; }
  2217. SHAR_EOF
  2218. if test 1553 -ne "`wc -c < 'bs2/bslib.c'`"
  2219. then
  2220.     echo shar: error transmitting "'bs2/bslib.c'" '(should have been 1553 characters)'
  2221. fi
  2222. fi # end of overwriting check
  2223. echo shar: extracting "'bs2/errors.c'" '(1583 characters)'
  2224. if test -f 'bs2/errors.c'
  2225. then
  2226.     echo shar: will not over-write existing file "'bs2/errors.c'"
  2227. else
  2228. sed 's/^X//' << \SHAR_EOF > 'bs2/errors.c'
  2229. /* errors.c -- error message routines for int.
  2230.  */
  2231.  
  2232. #include "bsdefs.h"
  2233.  
  2234.  
  2235. /* ULerror() -- unknown line (cannot find wanted line)
  2236.  */
  2237. ULerror(l,p) int(*l[])(),p;
  2238. {
  2239.     fprintf(stderr,"Unknown line %d\n",*(l[p]));
  2240.     exit(1);
  2241. }
  2242.  
  2243. /* STerror() -- wrong value for status variable
  2244.  */
  2245. XSTerror(f) char *f;
  2246. {
  2247.     fprintf(stderr,"%s: illegal status %o\n",f,status);
  2248.     exit(1);
  2249. }
  2250. /* FNerror() -- For Next error
  2251.  */
  2252. XFNerror(l,p)
  2253. int (*l[])(),p;
  2254. {
  2255.     struct dictnode *nv;
  2256.     struct line *ll;
  2257.  
  2258.     ll = gllentry(l);
  2259.     nv = l[p-2];
  2260.     fprintf(stderr,"Next %s, For (something else), at line %u\n",
  2261.     nv->name,ll->num);
  2262.     exit(1);
  2263. }
  2264.  
  2265. ODerror(l,p)
  2266. int (*l[])(),p;
  2267. {
  2268.     struct line *ll;
  2269.     char *s;
  2270.     ll = gllentry(l);
  2271.     s = ((struct dictnode *)l[p])->name;
  2272.     fprintf(stderr,"Out of Data in line %u at var %s\b",ll->num,s);
  2273.     exit(1);
  2274. }
  2275.  
  2276. BDerror(l,p)
  2277. int (*l[])(),p;
  2278. {
  2279.     struct line *ll;
  2280.     char *s;
  2281.     ll = gllentry(l);
  2282.     s = ((struct dictnode *)l[p])->name;
  2283.     fprintf(stderr,"Bad Data type in line %u at var %s\n",ll->num,s);
  2284.     exit(1);
  2285. }
  2286.  
  2287. VTerror(l,p)
  2288. int (*l[])(),p;
  2289. {
  2290.     struct dictnode *vp;
  2291.     vp = (struct dictnode *)l[p];
  2292.     fprintf(stderr,"Invalid data type %d for var %s\n",vp->type_of_value,vp->name);
  2293.     exit(1);
  2294. }
  2295.  
  2296. LVerror(l,p) int(*l[])(),p;
  2297. {
  2298.     struct line *ll;
  2299.     ll = gllentry(l);
  2300.     fprintf(stderr,"Tried to leave while not in a loop, at line %u\n",ll->num);
  2301.     exit(1);
  2302. }
  2303.  
  2304. CNerror(l,p) int(*l[])(),p;
  2305. {
  2306.     struct line *ll;
  2307.     ll = gllentry(l);
  2308.     fprintf(stderr,"Tried to continue while not in a loop, at line %u\n",ll->num);
  2309.     exit(1);
  2310. }
  2311. SHAR_EOF
  2312. if test 1583 -ne "`wc -c < 'bs2/errors.c'`"
  2313. then
  2314.     echo shar: error transmitting "'bs2/errors.c'" '(should have been 1583 characters)'
  2315. fi
  2316. fi # end of overwriting check
  2317. echo shar: extracting "'bs2/operat.c'" '(9158 characters)'
  2318. if test -f 'bs2/operat.c'
  2319. then
  2320.     echo shar: will not over-write existing file "'bs2/operat.c'"
  2321. else
  2322. sed 's/^X//' << \SHAR_EOF > 'bs2/operat.c'
  2323. /* operat.c -- operations, as opposed to actions.  FOR is an action,
  2324.  *    '+' is an operation.
  2325.  *
  2326.  * More operators can be found in the machine generated file "operat2.c".
  2327.  */
  2328.  
  2329. #include "bsdefs.h"
  2330.  
  2331.  
  2332. /*    BINARY OPERATORS    */
  2333.  
  2334. /* Common description for the binary ops.
  2335.  *  also applies to all ops in operat2.c
  2336.  *
  2337.  * M_COMPILE:
  2338.  *    x op x   --to--   x,_op,x
  2339.  * M_EXECUTE:
  2340.  *    stack: ar2,ar1,x   --to--   (ar1 op ar2),x
  2341.  */
  2342.  
  2343.  
  2344. _comma(l,p) int (*l[])(),p;
  2345. {
  2346.     union value s1,s2,s3;
  2347.     switch(status&XMODE) {
  2348.     case M_COMPILE:
  2349.     case M_FIXUP: return(p);
  2350.     case M_READ: dtype = T_CHR;
  2351.     case M_EXECUTE:
  2352.         s1 = pop();
  2353.         s2 = pop();
  2354.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+3);
  2355.         strcpy(s3.sval,s2.sval);
  2356.         strcat(s3.sval,"\t");
  2357.         strcat(s3.sval,s1.sval);
  2358.         if(s1.sval != 0) free(s1.sval);
  2359.         if(s2.sval != 0) free(s2.sval);
  2360.         push(s3);
  2361.         return(p);
  2362.     default: STerror("comma");
  2363.     }
  2364. }
  2365. _scolon(l,p) int(*l[])(),p;
  2366. {
  2367.     union value s1,s2,s3;
  2368.     switch(status&XMODE) {
  2369.     case M_COMPILE:
  2370.     case M_FIXUP: return(p);
  2371.     case M_READ: dtype = T_CHR;
  2372.     case M_EXECUTE:
  2373.         s1 = pop();
  2374.         s2 = pop();
  2375.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+2);
  2376.         strcpy(s3.sval,s2.sval);
  2377.         strcat(s3.sval,s1.sval);
  2378.         push(s3);
  2379.         if(s1.sval != 0) free(s1.sval);
  2380.         if(s2.sval != 0) free(s2.sval);
  2381.         return(p);
  2382.     default:
  2383.         STerror("scolon");
  2384.     }
  2385. }
  2386. /* last of binary operators */
  2387.  
  2388. /* M_COMPILE:
  2389.  *    x not x    --to--    x,_not,x
  2390.  * M_EXECUTE:
  2391.  *    stack: bool,x    --to--     !(bool),x
  2392.  */
  2393. _not(l,p) int (*l[])(),p;
  2394. {
  2395.     union value val;
  2396.  
  2397.     if((status&XMODE) == M_EXECUTE) {
  2398.     val = pop();
  2399.     val.ival = ! val.ival;
  2400.     push(val);
  2401.     }
  2402.     return(p);
  2403. }
  2404.  
  2405. /* M_COMPILE:
  2406.  *    x itoa x   --to--   x,_itoa,x
  2407.  * M_EXECUTE:
  2408.  *    stack: int,x   --to--   string,x
  2409.  */
  2410. _itoa(l,p)
  2411. int (*l[])(),p;
  2412. {
  2413.     union value val;
  2414.     char s2[30];
  2415.  
  2416.     switch(status&XMODE) {
  2417.     case M_FIXUP:
  2418.     case M_COMPILE: return(p);
  2419.     case M_READ:
  2420.         dtype = T_CHR;
  2421.     case M_EXECUTE:
  2422.         val=pop();
  2423.         sprintf(s2,"%D",val.ival);    /* optimize later */
  2424. if(dbg) printf("_icon():M_EXECUTE:ival:%D to sval:%s\n",val.ival,s2);
  2425.         val.sval=myalloc(strlen(s2)+1);
  2426.         strcpy(val.sval,s2);
  2427.         push(val);
  2428.         return(p);
  2429.     default:
  2430.         STerror("itoa");
  2431.     }
  2432. }
  2433. _rtoa(l,p)
  2434. int (*l[])(),p;
  2435. {
  2436.     union value val;
  2437.     char s2[30];
  2438.  
  2439.     switch(status&XMODE) {
  2440.     case M_FIXUP:
  2441.     case M_COMPILE: return(p);
  2442.     case M_READ: dtype = T_CHR;
  2443.     case M_EXECUTE:
  2444.         val = pop();
  2445.         sprintf(s2,"%g",val.rval);
  2446. if(dbg) printf("_rtoa():M_EXECUTE:rval:%g to sval:%s\n",val.rval,s2);
  2447.         val.sval = myalloc(strlen(s2)+1);
  2448.         strcpy(val.sval,s2);
  2449.         push(val);
  2450.         return(p);
  2451.     default: STerror("rtoa");
  2452.     }
  2453. }
  2454. _itor(l,p)
  2455. int (*l[])(),p;
  2456. {
  2457.     union value v1,v2;
  2458.  
  2459.     switch(status&XMODE) {
  2460.     case M_READ: dtype = T_DBL;
  2461.     case M_EXECUTE:
  2462.         v1 = pop();
  2463.         v2.rval = (double)v1.ival;
  2464.         push(v2);
  2465.     case M_FIXUP:
  2466.     case M_COMPILE: return(p);
  2467.     default: STerror("itor");
  2468.     }
  2469. }
  2470. _rtoi(l,p)
  2471. int (*l[])(),p;
  2472. {
  2473.     union value v1,v2;
  2474.  
  2475.     switch(status&XMODE) {
  2476.     case M_READ: dtype = T_INT;
  2477.     case M_EXECUTE:
  2478.         v1 = pop();
  2479.         v2.ival = (int)v1.rval;
  2480.         push(v2);
  2481.     case M_FIXUP:
  2482.     case M_COMPILE: return(p);
  2483.     default: STerror("rtoi");
  2484.     }
  2485. }
  2486.  
  2487. /* M_COMPILE:
  2488.  *    x scon "quoted string" x   --to--   x,_scon,*string,x
  2489.  * M_EXECUTE:
  2490.  *    stack: x   --to--   string,x
  2491.  *    other: pushes a COPY of the string, not the original.
  2492.  */
  2493. _scon(l,p)
  2494. int (*l[])(),p;
  2495. {
  2496.     char *s,c;
  2497.     union value val;
  2498.     int i;
  2499.  
  2500.     switch(status&XMODE) {
  2501.     case M_COMPILE:
  2502.         l[p++] = scon_in();
  2503.         return(p);
  2504.     case M_READ:
  2505.         dtype = T_CHR;
  2506.     case M_EXECUTE:
  2507.         s = l[p++];
  2508.         val.sval = myalloc(strlen(s)+1);
  2509.         strcpy(val.sval,s);
  2510.         push(val);
  2511. if(dbg) printf("_scon():M_EXECUTE:sval:%s\n",val.sval);
  2512.         return(p);
  2513.     case M_FIXUP: p++; return(p);
  2514.     default: STerror("scon");
  2515.     }
  2516. }
  2517.  
  2518. /* M_COMPILE:
  2519.  *    x icon int x   --to--   x,_icon,int,x
  2520.  * M_EXECUTE:
  2521.  *    stack: x   --to--   int,x
  2522.  */
  2523. _icon(l,p)
  2524. int (*l[])(),p;
  2525. {
  2526.     union value val;
  2527.     union loni v;
  2528.     int i;
  2529.  
  2530.     switch(status&XMODE) {
  2531.     case M_COMPILE:
  2532.         v.l_in_loni = atol(int_in());
  2533.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  2534.         l[p++] = v.i_in_loni[i];
  2535.         return(p);
  2536.     case M_READ: dtype = T_INT;
  2537.     case M_EXECUTE:
  2538.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  2539.         v.i_in_loni[i] = l[p++];
  2540.         val.ival = v.l_in_loni;
  2541.         push(val);
  2542. if(dbg) printf("_icon():M_EXECUTE:ival:%D\n",val.ival);
  2543.         return(p);
  2544.     case M_FIXUP:
  2545.         p += (sizeof(long)/sizeof(int));
  2546.         return(p);
  2547.     default: STerror("icon");
  2548.     }
  2549. }
  2550. _rcon(l,p)
  2551. int (*l[])(),p;
  2552. {
  2553.     union doni v;
  2554.     int i;
  2555.     union value val;
  2556.  
  2557.     switch(status&XMODE) {
  2558.     case M_COMPILE:
  2559.         v.d_in_doni = atof(real_in());
  2560.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  2561.         l[p++] = v.i_in_doni[i];
  2562.         return(p);
  2563.     case M_FIXUP:
  2564.         p += (sizeof(double)/sizeof(int));
  2565.         return(p);
  2566.     case M_READ: dtype = T_DBL;
  2567.     case M_EXECUTE:
  2568.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  2569.         v.i_in_doni[i] = l[p++];
  2570.         val.rval = v.d_in_doni;
  2571.         push(val);
  2572.         return(p);
  2573.     default: STerror("rcon");
  2574.     }
  2575. }
  2576.  
  2577. /* M_COMPILE:
  2578.  *    x val type x   --to--   x,_val,type,x
  2579.  * M_EXECUTE:
  2580.  *    stack:    place,x   --to--   value,x
  2581.  *    other: for strings, pushes a copy of the string.
  2582.  */
  2583. _val(l,p) int(*l[])(),p;
  2584. {
  2585.     union value place,val;
  2586.     int ty;
  2587.  
  2588.     switch(status&XMODE) {
  2589.     case M_COMPILE:
  2590.         l[p++] = atoi(int_in());
  2591.         return(p);
  2592.     case M_READ:
  2593.         dtype = l[p];
  2594.     case M_EXECUTE:
  2595.         ty = l[p];
  2596.         place = pop();
  2597. if(dbg) printf("_val():M_EXECUTE:var:%s",place.vpval->name);
  2598.         place.plval = getplace(place.vpval);
  2599.         if(ty==T_CHR && place.plval->sval!=0) {
  2600.         val.sval = myalloc(strlen(place.plval->sval)+1);
  2601.         strcpy(val.sval,place.plval->sval);
  2602.         push(val);
  2603.         }
  2604.         else push(*place.plval);
  2605. if(dbg) printf(":ival:%D:rval:%g:sval:%s\n",ty==T_INT?place.plval->ival:(long)0,
  2606.     ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  2607.     case M_FIXUP: p++; return(p);
  2608.     default: STerror("val");
  2609.     }
  2610. }
  2611.  
  2612. /* M_COMPILE:
  2613.  *    x store typ x   --to--    x,_store,type,x
  2614.  * M_EXECUTE:
  2615.  *    stack: value,location,x   --to--   value,x
  2616.  *        (stores value at location).
  2617.  */
  2618. _store(l,p) int(*l[])(),p;
  2619. {
  2620.     union value place,val;
  2621.     int ty;
  2622.  
  2623.     switch(status&XMODE) {
  2624.     case M_COMPILE:
  2625.         l[p++] = atoi(int_in());
  2626.         return(p);
  2627.     case M_READ:
  2628.         dtype = l[p];
  2629.     case M_EXECUTE:
  2630.         val = pop();
  2631.         place = pop();
  2632.         ty = l[p];
  2633. if(dbg) printf("_store():M_EXECUTE:var:%s:ival:%D:rval:%g:sval:%s\n",
  2634.     place.vpval->name,ty==T_INT?val.ival:(long)0,ty==T_DBL?val.rval:(double)0,ty==T_CHR?val.sval:0);
  2635.         place.plval = getplace(place.vpval);
  2636.         if(ty==T_CHR && place.plval->sval!=0) free(place.plval->sval);
  2637.         (*place.plval) = val;
  2638.         push(val);
  2639.     case M_FIXUP:
  2640.         p++;
  2641.         return(p);
  2642.     default: STerror("store");
  2643.     }
  2644. }
  2645.  
  2646. /* M_COMPILE:
  2647.  *    x var typ name x   --to--    x,_var,&vlist entry,x
  2648.  * M_EXECUTE:
  2649.  *    stack: x   --to--   &vlist entry,x
  2650.  * M_INPUT:
  2651.  *    (&vlist entry)->val is set to input value.
  2652.  * M_READ:
  2653.  *    Moves the data list pointers to the next data item.  If no next
  2654.  *    data item, calls ODerror.
  2655.  *    Does a "gosub" to the data item, to get its value on the stack.
  2656.  *    Does T_INT to T_CHR conversion if necessary.
  2657.  *    Pops value into vp->val.
  2658.  */
  2659. _var(l,p) int(*l[])(),p; /* same proc for any variable type */
  2660. {
  2661.     char *s;
  2662.     struct dictnode *vp;
  2663.     struct line *thislist;
  2664.     union value place,val;
  2665.     int ty,qual;
  2666.  
  2667.     switch(status&XMODE) {
  2668.     case M_COMPILE:
  2669.         ty = atoi(int_in());
  2670.         s = gtok();
  2671.         l[p++] = gvadr(s,ty);
  2672.         return(p);
  2673.     case M_EXECUTE:
  2674.         val.vpval = l[p++];
  2675. if(dbg) printf("_var():M_EXECUTE:var:(%d)%s\n",val.vpval->type_of_value,
  2676.     val.vpval->name);
  2677.         push(val);
  2678.         return(p);
  2679.     case M_INPUT:
  2680.         vp = l[p++];
  2681.         place.plval = getplace(vp);
  2682.         ty = (vp->type_of_value) & T_TMASK;
  2683.         if(ty == T_INT)
  2684.         place.plval->ival = atol(int_in());
  2685.         else if(ty == T_DBL)
  2686.         place.plval->rval = atof(real_in());
  2687.         else 
  2688.         place.plval->sval = scon_in();
  2689. if(dbg) printf("_var():M_INPUT:var:(%d)%s:ival:%D:rval:%g:sval:%s\n",
  2690. vp->type_of_value,vp->name,ty==T_INT?place.plval->ival:(long)0,
  2691. ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  2692.         return(p);
  2693.     case M_READ:
  2694. nxdl:        if(dlist[dlp] == 0) ODerror(l,p);    /* ran off end of dlist */
  2695.         thislist = dlist[dlp];
  2696.         if((thislist->code)[dlindx] == 0) {
  2697.         dlp++;
  2698.         dlindx = 2;    /* skips <_data,0> */
  2699.         goto nxdl;
  2700.         }
  2701.  
  2702.         status = M_EXECUTE;
  2703.         dlindx = interp(thislist->code,dlindx);
  2704.         status = M_READ;
  2705.  
  2706.         val = pop();
  2707.         vp = l[p];
  2708.         place.plval = getplace(vp);
  2709.         qual = vp->type_of_value&T_TMASK;
  2710.         if(qual == T_INT)
  2711.         place.plval->ival = val.ival;
  2712.         else if(qual == T_DBL)
  2713.         place.plval->rval = val.rval;
  2714.         else if(qual == T_CHR) {
  2715.         if(dtype == T_INT) {
  2716.             push(val); _itoa(l,p); val = pop();
  2717.         }
  2718.         else if(dtype == T_DBL) {
  2719.             push(val); _rtoa(l,p); val = pop();
  2720.         }
  2721.         if(place.plval->sval != 0) free(place.plval->sval);
  2722.         place.plval->sval = myalloc(strlen(val.sval)+1);
  2723.         strcpy(place.plval->sval,val.sval);
  2724.         }
  2725.         else VTerror(l,p);
  2726.     case M_FIXUP:
  2727.         p++;
  2728.         return(p);
  2729.     default: STerror("var");
  2730.     }
  2731. }
  2732. SHAR_EOF
  2733. if test 9158 -ne "`wc -c < 'bs2/operat.c'`"
  2734. then
  2735.     echo shar: error transmitting "'bs2/operat.c'" '(should have been 9158 characters)'
  2736. fi
  2737. fi # end of overwriting check
  2738. #    End of shell archive
  2739. exit 0
  2740.